---
title: "Replication of: Populism and Candidate Support in the US: The Effects of Thin and Host Ideology"
author: "Bruno Castanho Silva, Fabian G. Neuner, and Christopher Wratil"
date: "2/22/2022"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = F, warning=F)
```

# Overview

This Rmarkdown file replicates the article “Populism and Candidate Support in the US: The Effects of “Thin” and “Host” Ideology” by Bruno Castanho Silva, Fabian G. Neuner, and Christopher Wratil, published in the Journal of Experimental Political Science. Please see the accompanying README file for additional information.  

# Data and packages

```{r}
library(tidyverse)
library(cregg)
library(dotwhisker)
library(psych)
library(stargazer)
library(xtable)
library(gtools)

data_conjoint <- read.csv('castanho_silva_et_al_replication_dataset.csv',
                          stringsAsFactors = T)
```

# Manuscript

### Figure 1

```{r fig.width = 12, fig.height = 9}
# Run the conjoint model with cj:
results_main <- cj(votefor ~ 
                     A1_immigration + 
                     A2_military +
                     A3_redistribution + 
                     A4_globalization +
                     B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                   data = data_conjoint, id = ~id, estimate = "mm")

# Rename column in output to apply plotting function later:
names(results_main)[4]="term"

# Remove estimates for "no priority", meaning when a given priority doesn't appear
results_main <- results_main[str_sub(levels(results_main$term), 1, 2) != "No",]

# Relabel priorities for plot:
label_changes = c("Is for greatly decreasing the number of legal immigrants" = "Is for greatly decreasing the number of legal immigrants", 
                  "Is for somewhat decreasing the number of legal immigrants" = "Is for somewhat decreasing the number of legal immigrants",
                  "Is for somewhat increasing the number of legal immigrants" = "Is for somewhat increasing the number of legal immigrants",
                  "Is for greatly increasing the number of legal immigrants" = "Is for greatly increasing the number of legal immigrants",
                  "Is for much less military intervention" = "Is for much less military intervention",
                  "Is for somewhat less military intervention" = "Is for somewhat less military intervention",
                  "Is for somewhat more military intervention" = "Is for somewhat more military intervention",
                  "Is for much more military intervention" = "Is for much more military intervention",
                  "Is for much lower taxes on the rich" = "Is for much lower taxes on the rich",
                  "Is for somewhat lower taxes on the rich" = "Is for somewhat lower taxes on the rich",
                  "Is for somewhat higher taxes on the rich" = "Is for somewhat higher taxes on the rich",
                  "Is for much higher taxes on the rich" = "Is for much higher taxes on the rich",
                  "Is for much less free trade and globalization" = "Is for much less free trade and globalization",
                  "Is for somewhat less free trade and globalization" = "Is for somewhat less free trade and globalization",
                  "Is for somewhat more free trade and globalization" = "Is for somewhat more free trade and globalization",
                  "Is for much more free trade and globalization" = "Is for much more free trade and globalization",
                  "Priority1" = "Fight political corruption",
                  "Priority2" = "End the abuse of power by the parties",
                  "Priority3" = "Overthrow the political elite",
                  "Priority4" = "Strengthen direct democracy",
                  "Priority5" = "Defend citizens' interests",
                  "Priority6" = "Improve environmental protection",
                  "Priority7" = "Promote economic growth",
                  "Priority8" = "Strengthen social justice",
                  "Priority9" = "Prevent Islamization",
                  "Priority10" = "Fight crime",
                  "Priority11" = "Strengthen civil rights and civil liberties",
                  "Priority12" = "Make globalization more fair")

# Create brackets for plot
brackets <- list(c("Position on \nImmigrants", "Is for greatly decreasing the number of legal immigrants", "Is for greatly increasing the number of legal immigrants"),
                 c("Position on \nMilitary Intervention", "Is for much less military intervention", "Is for much more military intervention"),
                 c("Position on \nTaxes", "Is for much lower taxes on the rich", "Is for much higher taxes on the rich"),
                 c("Position on \nGlobalization", "Is for much less free trade and globalization", "Is for much more free trade and globalization"),
                 c("Populist \nPriorities", "Fight political corruption", "Defend citizens' interests"),
                 c("Other \nPriorities", "Improve environmental protection", "Make globalization more fair"))

#Produce Figure 1 in the article
p={dwplot(results_main, dot_args = list(size = 3)) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "gray50", linetype = 'dashed') +
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") +
    ggtitle("") + scale_color_manual(values = c("black")) +
    theme(plot.title = element_text(face="bold"),
          legend.position = "none",
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))} %>%
  add_brackets(brackets, face = "bold") 

# Plot
p
```

### Figure 2

Create the populist/non-populist subgroups and run cj:

```{r}
# First run factor analysis to identify populist individuals

#Create matrix only with thin populism items
thin_pop <- data_conjoint %>% select("id", "thin_pop1", "thin_pop2", "thin_pop3", "thin_pop4", "thin_pop5", 
"thin_pop6", "thin_pop7", "thin_pop8") %>%
  distinct(id, .keep_all = T) 

names(thin_pop)[2:9] <- c('Pop1','Pop2','Pop3','Pop4','Pop5','Pop6','Pop7','Pop8')
# Run EFA model
fa_thin_pop <- fa(thin_pop[,2:9], nfactors = 1, scores = "regression", cor = "poly")

# Save factor scores:
fa_scores <- data_frame(id = thin_pop$id,
                        scores = fa_thin_pop$scores)

# Merge with conjoint data:
data_conjoint <- left_join(data_conjoint, fa_scores, by = 'id')

# Create two subgroups in conjoint data:
data_conjoint <- mutate(data_conjoint, 
                        populist_cat = as.factor(case_when(scores >= 0 ~ 'Populists',
                                                           scores < 0 ~ 'Non-populists')))

# Run conjoint model:
results_subgroups <- cj(votefor ~ 
                     A1_immigration + 
                     A2_military +
                     A3_redistribution + 
                     A4_globalization +
                     B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                   data = data_conjoint, id = ~id, estimate = "mm", by = ~populist_cat)

```

Plots:

```{r fig.width = 11, fig.height = 6}
## Redefine names of the object to be plotted:
names(results_subgroups)[names(results_subgroups)=="level"]="term"
names(results_subgroups)[names(results_subgroups)=="populist_cat"]="model"

## Select only estimates for populist positions:
results_subgroups_populist_positions <- results_subgroups %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")

## Select only estimates for populist priorities:
results_subgroups_populist_priorities <- results_subgroups %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Plot positions:
{dwplot(results_subgroups_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "gray50",linetype = 'dashed') + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20))  + guides(colour = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.80, 0.2),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}

# Plot priorities:
{dwplot(results_subgroups_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "gray50", linetype = 'dashed') + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20))  + guides(colour = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.2),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}
```

### Figure 3

```{r fig.width = 11, fig.height = 6}
#Conjoint analysis by partisanship
data_conjoint <- mutate(data_conjoint,
                        party_id = ordered(party_id,
                                           levels = c('Republican','Democrat',
                                           'Independent')))
results_subgroups <- cj(votefor ~ 
                          A1_immigration + 
                          A2_military +
                          A3_redistribution + 
                          A4_globalization +
                          B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                        data = data_conjoint, id = ~id, estimate = "mm", by = ~party_id)

# Rename parts of output for plotting:
names(results_subgroups)[names(results_subgroups)=="level"]="term"
names(results_subgroups)[names(results_subgroups)=="party_id"]="model"

# Save the main results to use later when plotting all estimates on partisanship
results_main_by_partisanship <- results_subgroups[ str_sub(levels(results_subgroups$term), 1, 2) != "No",]

# Subset for populist positions
results_subgroups_populist_positions <- results_subgroups %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")

# Subset for populist priorities:
results_subgroups_populist_priorities <- results_subgroups %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Top part Figure 3:
p <- dwplot(results_subgroups_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "gray50",linetype = 'dashed') + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22")) + scale_shape_manual(values = c(0,20,19))  + guides(colour = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.8),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))
p

# Bottom part figure 3:

dwplot(results_subgroups_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "gray50",linetype = 'dashed') + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22")) + scale_shape_manual(values = c(0,20,19)) +
    guides(colour = F)  +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.90, 0.8),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))
```

# Online Appendix

### Table A.1

```{r results = 'asis'}
df.desc <- select(data_conjoint, hhi,Education, age, female,
                  White, Black, Hispanic) %>%
  rename(., `Household Income` = hhi,
         Age = age,
         Female = female)

stargazer(df.desc, omit.summary.stat = c('p25', 'p75', 'n'),
                     summary.stat = c('mean','median'),
                     header = F, type = 'html')
```


### Table A.3 

Left-hand side loadings:
```{r}
# Loadings from the earlier factor analysis of thin populism (left-hand side of Table A.3):
fa_thin_pop$loadings
```

Right-hand side loadings:
```{r}
## Run FA for host-ideology populism:

# Select relevant variables for thick populism:
thick_pop <- data_conjoint %>% select("id", "thick_pop1_immigrants", "thick_pop2_tariffs", "thick_pop3_intervention", "thick_pop4_rich") %>%
  distinct(id, .keep_all = T) %>%
  select(., -id)

names(thick_pop) <- c('Host1','Host2','Host3','Host4')

# Run EFA model
fa_thick_pop <- fa(thick_pop, nfactors = 1, scores = "regression", cor = "poly")

# Loadings (right-hand side of Table A.3):
print(fa_thick_pop$loadings, cutoff = 0)
```

# Figure A.2

First plot, thin populist positions:
```{r}
scree(thin_pop[,2:9])
```

Second plot, host ideology:

```{r}
scree(thick_pop)
```

# Figure A.3

```{r fig.width = 11, fig.height = 6}
# Identify the candidate (left or right):
data_conjoint$candidate <- seq(1, 2, by = 1)
data_conjoint$candidate <- factor(data_conjoint$candidate,
                                     levels = c(1,2),
                                     labels = c("Candidate A", "Candidate B"))
# Identify the choice (1 through 5)
data_conjoint$choice_task[data_conjoint$candidate == "Candidate A"] <- seq(1, 5, by=1)
data_conjoint$choice_task[data_conjoint$candidate == "Candidate B"] <- seq(1, 5, by=1)
data_conjoint$choice_task <- as.factor(data_conjoint$choice_task)

#Conjoint analysis by choice task (1st to 5th)
results_carryover <- cj(votefor ~ 
                          A1_immigration + 
                          A2_military +
                          A3_redistribution + 
                          A4_globalization +
                          B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                        data = data_conjoint, id = ~id, estimate = "mm", by = ~choice_task)

# Rename terms of output for plotting:
names(results_carryover)[names(results_carryover)=="level"]="term"
names(results_carryover)[names(results_carryover)=="choice_task"]="model"

# Select only populist positions for plotting:
results_carryover_populist_positions <- results_carryover %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")

# Select only populist priorities for plotting:
results_carryover_populist_priorities <- results_carryover %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Top part:
dwplot(results_carryover_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.70) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22", "grey22", "grey22")) + scale_shape_manual(values = c(2, 0, 20, 19, 15)) +
    guides(shape = guide_legend(ncol = 3)) + 
  guides(color = F) + theme(plot.title = element_text(face="bold"),
                                                 legend.position = c(0.85, 0.10),
                                                 legend.title = element_blank(),
                                                 legend.text=element_text(size=12),
                                                 axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))


# Bottom part:
dwplot(results_carryover_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.70) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22", "grey22", "grey22")) + scale_shape_manual(values = c(2, 0, 20, 19, 15)) +
    guides(shape = guide_legend(ncol = 3)) + 
  guides(color = F) + theme(plot.title = element_text(face="bold"),
                                                 legend.position = c(0.85, 0.10),
                                                 legend.title = element_blank(),
                                                 legend.text=element_text(size=12),
                                                 axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))
```


### Figure A.4

```{r fig.width = 11, fig.height = 6}
#Conjoint analysis by profile order (candidate on left vs. right side of screen)
results_profile <- cj(votefor ~ 
                          A1_immigration + 
                          A2_military +
                          A3_redistribution + 
                          A4_globalization +
                          B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                        data = data_conjoint, id = ~id, estimate = "mm", by = ~candidate)

# Rename and select estimates of interest for plotting:
names(results_profile)[names(results_profile)=="level"]="term"
names(results_profile)[names(results_profile)=="candidate"]="model"
results_profile_populist_positions <- results_profile %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")
results_profile_populist_priorities <- results_profile %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Top panel
{dwplot(results_profile_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.65) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(3, 4)) +
    guides(color = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.10),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}

# Bottom panel
{dwplot(results_profile_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.65) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22")) +
    guides(color = F) + scale_shape_manual(values = c(3, 4)) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.10),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}
```

### Figure A.5

```{r fig.width = 12, fig.height = 10}
# Plot using the results by partisanship estimated earlier:
{dwplot(results_main_by_partisanship, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.75) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22")) + scale_shape_manual(values = c(0, 20, 19)) +
    guides(color = F) + 
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.80, 0.1),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}
```

### Figure A.6

```{r fig.width = 11, fig.height = 6}
#Create subgroups
data_conjoint$populist_cat2 <- quantcut(data_conjoint$scores)
data_conjoint$populist_cat2 <- recode(data_conjoint$populist_cat2, '[-3.75,-0.632]' = "1st quartile", '(-0.632,0.102]' = "2nd quartile", '(0.102,0.691]' = "3rd quartile", '(0.691,1.63]' = "4th quartile")

#Conjoint analysis by quartile of populist attitudes
results_subgroups <- cj(votefor ~ 
                          A1_immigration + 
                          A2_military +
                          A3_redistribution + 
                          A4_globalization +
                          B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                        data = data_conjoint, id = ~id, estimate = "mm", by = ~populist_cat2)

# Rename and subset relevant estimates for plotting:
names(results_subgroups)[names(results_subgroups)=="level"]="term"
names(results_subgroups)[names(results_subgroups)=="populist_cat2"]="model"
results_subgroups_populist_positions <- results_subgroups %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")
results_subgroups_populist_priorities <- results_subgroups %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Top-panel:
{dwplot(results_subgroups_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22", "grey22")) + scale_shape_manual(values = c(0, 20, 19, 15)) +
    guides(color = F) + 
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.80, 0.15),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}

# Bottom panel:
{dwplot(results_subgroups_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22", "grey22")) + scale_shape_manual(values = c(0, 20, 19, 15)) +
    guides(color = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.15),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}
```

### Figure A.7

```{r fig.width = 11, fig.height = 6}
#### Recode to identify profiles that are in favor/against higher taxes and immigration:
data_conjoint <- data_conjoint %>%
  mutate(., pro_tax_rich = case_when(A3_redistribution %in% c('Is for much higher taxes on the rich','Is for somewhat higher taxes on the rich') ~ 1,
                                     T ~ 0),
         pro_immigration = case_when(A1_immigration %in% c('Is for somewhat increasing the number of legal immigrants','Is for greatly increasing the number of legal immigrants') ~ 1,
                                     T ~ 0)) %>%
  group_by(id, choice_task) %>%
  mutate(., both_pro_tax_rich = case_when(sum(pro_tax_rich) == 2 ~ 1,
                                          T ~ 0),
         both_anti_tax_rich = case_when(sum(pro_tax_rich) == 0 ~ 1,
                                        T ~ 0 ),
         both_pro_imm = case_when(sum(pro_immigration) == 2 ~ 1,
                                  T ~ 0),
         both_anti_imm = case_when(sum(pro_immigration) == 0 ~ 1,
                                   T ~ 0)) %>%
  ungroup()

# Conjoint analysis fixing anti-immigration:
results_main_anti_imm <- cj(votefor ~ 
                         A2_military +
                         A3_redistribution + 
                         A4_globalization +
                         B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                       data = subset(data_conjoint, both_anti_imm == 1), id = ~id, by= ~ party_id, estimate = "mm")

names(results_main_anti_imm)[names(results_main_anti_imm)=="level"]="term"
names(results_main_anti_imm)[names(results_main_anti_imm)=="party_id"]="model"

results_main_anti_imm <- results_main_anti_imm %>% filter(term == "Is for much lower taxes on the rich" | term == "Is for somewhat lower taxes on the rich" | term == "Is for much higher taxes on the rich" | term == "Is for somewhat higher taxes on the rich")


# Top:

{dwplot(results_main_anti_imm, dot_args = list(size = 3, aes(shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") +
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + guides(colour = 'none') +
    ggtitle("Both Profiles Anti-Immigration") + scale_color_manual(values = c("black",'black','black')) +  scale_shape_manual(values = c(0, 20, 19)) +
    guides(color = F) + 
    theme(plot.title = element_text(face="bold"),
          legend.position = "bottom", legend.title = element_blank(),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))} 


# Conjoint analysis fixing positions on immigration:
results_main_imm <- cj(votefor ~ 
                     A2_military +
                     A3_redistribution + 
                     A4_globalization +
                     B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                   data = subset(data_conjoint, both_pro_imm == 1), id = ~id, by = ~party_id, estimate = "mm")

names(results_main_imm)[names(results_main_imm)=="level"]="term"
names(results_main_imm)[names(results_main_imm)=="party_id"]="model"

results_main_imm <- results_main_imm %>% filter(term == "Is for much lower taxes on the rich" | term == "Is for somewhat lower taxes on the rich" | term == "Is for much higher taxes on the rich" | term == "Is for somewhat higher taxes on the rich")

# Bottom panel:
{dwplot(results_main_imm, dot_args = list(size = 3, aes(shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") +
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + guides(colour = 'none') + 
    ggtitle("Both Profiles Pro-Immigration") + scale_color_manual(values = c("black",'black','black')) +  scale_shape_manual(values = c(0, 20, 19)) +
    guides(color = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = "bottom", legend.title = element_blank(),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))}
```

### Figure A.8

```{r fig.width = 11, fig.height = 6}

# Conjoint analysis fixing anti-taxation:
results_main_anti_tax <- cj(votefor ~ 
                              A1_immigration +
                              A2_military +
                              A4_globalization +
                              B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                            data = subset(data_conjoint, both_anti_tax_rich == 1), id = ~id, by= ~ party_id, estimate = "mm")

names(results_main_anti_tax)[names(results_main_anti_tax)=="level"]="term"
names(results_main_anti_tax)[names(results_main_anti_tax)=="party_id"]="model"
results_main_anti_tax <- results_main_anti_tax %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for somewhat decreasing the number of legal immigrants" | term == "Is for somewhat increasing the number of legal immigrants" | term == "Is for greatly increasing the number of legal immigrants")

# Top panel:
{dwplot(results_main_anti_tax, dot_args = list(size = 3, aes(shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") +
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + guides(colour = 'none') + 
    ggtitle("Both Profiles Against Higher Taxes on the Rich") + scale_color_manual(values = c("black",'black','black')) +  scale_shape_manual(values = c(0, 20, 19)) +
    guides(col = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = "bottom", legend.title = element_blank(),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))} 

# Conjoint analysis fixing pro-taxation
results_main_tax <- cj(votefor ~ 
                         A1_immigration +
                         A2_military +
                         A4_globalization +
                         B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                       data = subset(data_conjoint, both_pro_tax_rich == 1), id = ~id, by = ~party_id, estimate = "mm")

names(results_main_tax)[names(results_main_tax)=="level"]="term"
names(results_main_tax)[names(results_main_tax)=="party_id"]="model"

results_main_tax <- results_main_tax %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for somewhat decreasing the number of legal immigrants" | term == "Is for somewhat increasing the number of legal immigrants" | term == "Is for greatly increasing the number of legal immigrants")

# Bottom panel:
{dwplot(results_main_tax, dot_args = list(size = 3, aes(shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") +
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") +
    ggtitle("Both Profiles for Higher Taxes on the Rich") + scale_color_manual(values = c("black",'black','black')) +  scale_shape_manual(values = c(0, 20, 19)) +
    guides(colour = F) + 
    theme(plot.title = element_text(face="bold"),
          legend.position = "bottom", legend.title = element_blank(),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))}
```

### Figure A.9

Define primary races:
```{r}
data_conjoint <- data_conjoint %>%
  mutate(., true_gop = case_when(A1_immigration %in% c('Is for somewhat decreasing the number of legal immigrants','Is for greatly decreasing the number of legal immigrants') &
                                   A3_redistribution %in% c('Is for somewhat lower taxes on the rich','Is for much lower taxes on the rich') ~ 1,
                                 T ~ 0),
         true_dem = case_when(A1_immigration %in% c('Is for somewhat increasing the number of legal immigrants','Is for greatly increasing the number of legal immigrants') &
                                A3_redistribution %in% c('Is for much higher taxes on the rich','Is for somewhat higher taxes on the rich') ~ 1,
                              T ~ 0)) %>%
  group_by(id, choice_task) %>%
  mutate(., dem_primary = case_when(sum(true_dem) == 2 ~ 1,
                                    T ~ 0),
         gop_primary = case_when(sum(true_gop) == 2 ~ 1,
                                 T ~ 0)) %>%
  ungroup()
```

Democratic primary races:

```{r fig.width = 11, fig.height = 6}
# Conjoint analysis for democrat respondents in DEM primary:
results_subgroups_dem <- cj(votefor ~ 
                          A2_military +
                          A4_globalization +
                          B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                        data = subset(data_conjoint, dem_primary == 1 & party_id == 'Democrat'), id = ~id, estimate = "mm", by = ~populist_cat)

# Rename and subset for plotting:
names(results_subgroups_dem)[names(results_subgroups_dem)=="level"]="term"
names(results_subgroups_dem)[names(results_subgroups_dem)=="populist_cat"]="model"
results_subgroups_dem_populist_positions <- results_subgroups_dem %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")
results_subgroups_dem_populist_priorities <- results_subgroups_dem %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")


# Top panel:
{dwplot(results_subgroups_dem_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") +# xlim(0.3, 0.65) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("DEM Primary") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20)) + guides(colour = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.10),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}

# Bottom panel:

{dwplot(results_subgroups_dem_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + #xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("DEM Primary") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20)) +
    guides(color = F) + 
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.15),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}
```

### Figure A.10

Republican primary:

```{r fig.width = 11, fig.height = 6}
# Conjoint for Republican respondents in GOP primary:
results_subgroups_gop <- cj(votefor ~ 
                              A2_military +
                              A4_globalization +
                              B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                            data = subset(data_conjoint, gop_primary == 1 & party_id == 'Republican'), id = ~id, estimate = "mm", by = ~populist_cat)

# Rename and subset for plotting:
names(results_subgroups_gop)[names(results_subgroups_gop)=="level"]="term"
names(results_subgroups_gop)[names(results_subgroups_gop)=="populist_cat"]="model"
results_subgroups_gop_populist_positions <- results_subgroups_gop %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")
results_subgroups_gop_populist_priorities <- results_subgroups_gop %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Top panel:

{dwplot(results_subgroups_gop_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") +
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("GOP Primary") + guides(colour = 'none')+
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20)) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.10),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}


# Bottom panel:
{dwplot(results_subgroups_gop_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.25, 0.95) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("GOP Primary") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20)) + guides(colour = 'none')+
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.15),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}
```

### Figure A.11

```{r fig.width = 12, fig.height = 9}
# Remove respondents who failed attention check:
data_conjoint <- filter(data_conjoint, att1 == 3)

# Main conjoint analysis
results_main <- cj(votefor ~ 
                     A1_immigration + 
                     A2_military +
                     A3_redistribution + 
                     A4_globalization +
                     B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                   data = data_conjoint, id = ~id, estimate = "mm")

# Rename and subset for plotting:
names(results_main)[4]="term"
results_main <- results_main[str_sub(levels(results_main$term), 1, 2) != "No",]

{dwplot(results_main, dot_args = list(size = 3)) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") +
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") +
    ggtitle("") + scale_color_manual(values = c("black")) +
    theme(plot.title = element_text(face="bold"),
          legend.position = "none",
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))} %>%
  add_brackets(brackets, face = "bold") 
```

### Figure A.12

Run factor analysis to define populists:

```{r}
#Create matrix only with thin populism items
thin_pop <- data_conjoint %>% select("id", "thin_pop1", "thin_pop2", "thin_pop3", "thin_pop4", "thin_pop5", 
"thin_pop6", "thin_pop7", "thin_pop8") %>%
  distinct(id, .keep_all = T) 

names(thin_pop)[2:9] <- c('Pop1','Pop2','Pop3','Pop4','Pop5','Pop6','Pop7','Pop8')
# Run EFA model
fa_thin_pop <- fa(thin_pop[,2:9], nfactors = 1, scores = "regression", cor = "poly")

# Save factor scores:
fa_scores <- data_frame(id = thin_pop$id,
                        scores_att = fa_thin_pop$scores)

# Merge with conjoint data:
data_conjoint <- left_join(data_conjoint, fa_scores, by = 'id')

# Create two subgroups in conjoint data:
data_conjoint <- mutate(data_conjoint, 
                        populist_cat = as.factor(case_when(scores_att >= 0 ~ 'Populists',
                                                           scores_att < 0 ~ 'Non-populists')))

# Run conjoint model:
results_subgroups <- cj(votefor ~ 
                     A1_immigration + 
                     A2_military +
                     A3_redistribution + 
                     A4_globalization +
                     B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                   data = data_conjoint, id = ~id, estimate = "mm", by = ~populist_cat)
```

Plot:

```{r fig.width = 11, fig.height = 6}
## Redefine names of the object to be plotted:
names(results_subgroups)[names(results_subgroups)=="level"]="term"
names(results_subgroups)[names(results_subgroups)=="populist_cat"]="model"

## Select only estimates for populist positions:
results_subgroups_populist_positions <- results_subgroups %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")

## Select only estimates for populist priorities:
results_subgroups_populist_priorities <- results_subgroups %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Plot positions:
{dwplot(results_subgroups_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20))  + guides(colour = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.80, 0.2),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}

# Plot priorities:
{dwplot(results_subgroups_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22")) + scale_shape_manual(values = c(0, 20))  + guides(colour = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.2),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=14,colour="black"),axis.title=element_text(size=14))}
```

### Figure A.13

```{r fig.width = 11, fig.height = 6}
#Conjoint analysis by partisanship
results_subgroups <- cj(votefor ~ 
                          A1_immigration + 
                          A2_military +
                          A3_redistribution + 
                          A4_globalization +
                          B1_corruption + B2_parties + B3_elite + B4_democracy + B5_citizens + B6_environment + B7_growth + B8_justice + B9_islamization + C1_crime + C2_liberties + C3_globalization, 
                        data = data_conjoint, id = ~id, estimate = "mm", by = ~party_id)

# Rename parts of output for plotting:
names(results_subgroups)[names(results_subgroups)=="level"]="term"
names(results_subgroups)[names(results_subgroups)=="party_id"]="model"

# Save the main results to use later when plotting all estimates on partisanship
results_main_by_partisanship <- results_subgroups[ str_sub(levels(results_subgroups$term), 1, 2) != "No",]

# Subset for populist positions
results_subgroups_populist_positions <- results_subgroups %>% filter(term == "Is for greatly decreasing the number of legal immigrants" | term == "Is for much less military intervention" | term == "Is for much higher taxes on the rich" | term == "Is for much less free trade and globalization")

# Subset for populist priorities:
results_subgroups_populist_priorities <- results_subgroups %>% filter(term == "Priority1" | term == "Priority2" | term == "Priority3" | term == "Priority4" | term == "Priority5")

# Top part Figure A.13:
dwplot(results_subgroups_populist_positions, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22")) + scale_shape_manual(values = c(0,20,19))  + guides(colour = F) +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.85, 0.8),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))


# Bottom part figure A.13:

dwplot(results_subgroups_populist_priorities, dot_args = list(size = 3, aes(colour = model, shape = model))) %>% 
    relabel_predictors(label_changes) + geom_vline(xintercept=0.5, colour = "red") + xlim(0.3, 0.7) + 
    theme_bw() + xlab("Probability that candidate will be chosen") + ylab("") + ggtitle("") +
    scale_color_manual(values = c("grey22", "grey22", "grey22")) + scale_shape_manual(values = c(0,20,19)) +
    guides(colour = F)  +
    theme(plot.title = element_text(face="bold"),
          legend.position = c(0.90, 0.8),
          legend.title = element_blank(),
          legend.text=element_text(size=12),
          axis.text=element_text(size=12,colour="black"),axis.title=element_text(size=12))
```
